home *** CD-ROM | disk | FTP | other *** search
/ Over 1,000 Windows 95 Programs / Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso / 1263 / fxt_me.cmd < prev    next >
Encoding:
Text File  |  1997-04-18  |  8.8 KB  |  251 lines
  1. ;*****************************************************************************
  2. ;
  3. ;   FXT_ME.CMD - MicroEMACS MACRO FUNCTIONS FOR
  4. ;
  5. ;       FFTN (TM) FORTRAN FUNCTION TREE NAVIGATOR
  6. ;
  7. ;   Copyright (C) Juergen Mueller (J.M.) 1992-1996
  8. ;   All rights reserved.
  9. ;
  10. ;   You are expressly prohibited from selling this software in any form,
  11. ;   distributing it with another product, or removing this notice.
  12. ;
  13. ;   Limited permission is given to registered FXT users to modify this
  14. ;   file for their own personal use only. This file may not be used for any
  15. ;   purpose other than in conjunction with the FXT software package.
  16. ;
  17. ;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND,
  18. ;   EITHER EXPRESSED OR IMPLIED, INCLUDING, WITHOUT LIMITATION, THE
  19. ;   IMPLIED WARRANTIES OF MERCHANTIBILITY OR FITNESS FOR A PARTICULAR
  20. ;   PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
  21. ;   PROGRAM AND DOCUMENTATION IS WITH YOU.
  22. ;
  23. ;   written by: Juergen Mueller, Aldingerstrasse 22, D-70806 Kornwestheim,
  24. ;               GERMANY
  25. ;
  26. ;   FILE       : FXT_ME.CMD
  27. ;   REVISION   : 27-Apr-1996
  28. ;                18:31:21
  29. ;
  30. ;*****************************************************************************
  31.  
  32. ; NOTE: for OS/2 you should exchange "fftn" with "fftn4os2"
  33. ; NOTE: for Windows NT / Windows 95 you should exchange "fftn" with "fftn32"
  34.  
  35. ;*****************************************************************************
  36. ;**** write initial message ****
  37. ;*****************************************************************************
  38. write-message "Loading FXT macro package"
  39.  
  40. ;*****************************************************************************
  41. ;**** macro package initialization section ****
  42. ;*****************************************************************************
  43. set %fxt_item ""                ; set internal variables
  44. set %fxt_file ""
  45. set %fxt_line ""
  46. set %fxtn_cmd ""
  47. set %char_set "_$abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
  48.  
  49. set %fft_base &env "FFTNBASE"   ; get environment variables, if set
  50.  
  51. ;*****************************************************************************
  52. ;**** definition of user macros ****
  53. ;*****************************************************************************
  54.  
  55. ;**** find function ****
  56. store-procedure fft
  57.         execute-procedure _extract_item         ; get tagged item
  58.         execute-procedure _fxt_fft
  59. !endm
  60.  
  61. ;**** find function ****
  62. store-procedure fftmark
  63.         execute-procedure _extract_marked_item  ; get marked item
  64.         execute-procedure _fxt_fft
  65. !endm
  66.  
  67. ;**** find function ****
  68. store-procedure fftfind
  69.         set %fxt_item "FFT function name: "
  70.         set %fxt_item @%fxt_item                ; get user input
  71.         execute-procedure _fxt_fft
  72. !endm
  73.  
  74. ;**** set FFT database name ****
  75. store-procedure fftbase
  76.         set %fft_base "FFT database name: "
  77.         set %fft_base @%fft_base                ; get user input
  78. !endm
  79.  
  80. ;**** FFT file list
  81. store-procedure fftfile
  82.         write-message "Extracting FFT filelist"
  83.  
  84.         !if ¬ &seq &len %fft_base 0
  85.           set %tmp &cat &cat "-f" %fft_base " "         ; database access path
  86.         !else
  87.           set %tmp ""
  88.         !endif
  89.  
  90.         set %fxtn_cmd &cat "fftn -F " %tmp
  91.         pipe-command %fxtn_cmd          ; perform database access, shell command
  92. !endm
  93.  
  94. ;*****************************************************************************
  95. ;**** internal macro execution functions ****
  96. ;*****************************************************************************
  97.  
  98. ;*****************************************************************************
  99. ;* FFT front-end *
  100. ;*****************************************************************************
  101. store-procedure _fxt_fft
  102.         !if &seq &len %fxt_item 0
  103.           write-message "No function selected"
  104.           !return
  105.         !endif
  106.  
  107.         write-message &cat &cat "Searching for function: '" %fxt_item "'"
  108.  
  109.         !if ¬ &seq &len %fft_base 0
  110.           set %tmp &cat &cat "-f" %fft_base " "         ; database access path
  111.         !else
  112.           set %tmp ""
  113.         !endif
  114.  
  115.         set %fxtn_cmd &cat &cat "fftn -b " %tmp %fxt_item
  116.         execute-procedure _fxt_search                   ; start search
  117. !endm
  118.  
  119. ;*****************************************************************************
  120. ;* the database retrieval function *
  121. ;*****************************************************************************
  122. store-procedure _fxt_search
  123.         set %fxt_file ""                ; clear variables
  124.         set %fxt_line ""
  125.  
  126. !force  pipe-command %fxtn_cmd          ; perform database access, shell command
  127.         !if &seq $status FALSE
  128.           !return
  129.         !endif
  130.  
  131. !force  select-buffer command           ; get result buffer from pipe-command
  132.         !if &seq $status FALSE
  133.           !return
  134.         !endif
  135.  
  136. !force  beginning-of-file               ; go to file begin
  137.         !if &seq $status FALSE
  138.           !return
  139.         !endif
  140.  
  141.         set-mark                        ; extract target file name
  142.  
  143. !force  search-forward " "              ; search for first blank after file name
  144.         !if &seq $status FALSE
  145.           !return
  146.         !endif
  147.  
  148.         backward-character
  149.         copy-region
  150.         set %fxt_file $kill             ; store target file name
  151.         forward-character
  152.         set-mark                        ; extract target file line
  153.         end-of-line
  154.         copy-region
  155.         set %fxt_line $kill             ; store target file line
  156.  
  157. !force  delete-window                   ; delete command window
  158. !force  delete-buffer command           ; delete command buffer
  159. !force  next-buffer                     ; switch to next buffer just to hide command buf
  160.  
  161.         !if ¬ &exist %fxt_file       ; test if file exists
  162.           write-message &cat &cat "Target file ~"" %fxt_file "~" not found"
  163.           !return
  164.         !endif
  165.  
  166. !force  find-file %fxt_file             ; open target file
  167.  
  168.         !if &seq $status TRUE
  169. !force    goto-line %fxt_line           ; jump to target line
  170.  
  171.           !if &seq $status FALSE
  172.             clear-message-line
  173.             !return
  174.           !endif
  175.  
  176.           delete-other-windows          ; just for safety
  177.           redraw-display                ; center target line
  178.           clear-message-line
  179.         !endif
  180. !endm
  181.  
  182. ;*****************************************************************************
  183. ;* read search item from current buffer *
  184. ;*****************************************************************************
  185. store-procedure _extract_item
  186.         set %fxt_item ""                ; clear variable
  187.  
  188.         !if &seq &sindex %char_set &chr $curchar 0
  189.           !return                       ; not on a valid character
  190.         !endif
  191.  
  192. !force  end-of-word
  193.  
  194.         !while TRUE
  195. !force  previous-word
  196. !force  backward-character
  197.         !if &seq &sindex %char_set &chr $curchar 0
  198. !force    forward-character
  199.           !break
  200.         !endif
  201.         !endwhile
  202.  
  203.         set-mark                        ; mark first item character
  204.  
  205.         !while TRUE
  206. !force  end-of-word                     ; goto end of item
  207.         !if &seq &sindex %char_set &chr $curchar 0
  208.           !break
  209.         !endif
  210.         !endwhile
  211.  
  212.         copy-region
  213.         set %fxt_item $kill             ; store item name
  214. !endm
  215.  
  216. ;*****************************************************************************
  217. ;* read marked search item *
  218. ;*****************************************************************************
  219. store-procedure _extract_marked_item
  220.         set %fxt_item ""                                ; clear variable
  221. !force  copy-region
  222.         set %fxt_item $kill                             ; store item name
  223.  
  224.         !if ¬ &seq &len %fxt_item 0
  225.           set %fxt_item &cat &cat "~"" %fxt_item "~""   ; quote
  226.         !endif
  227. !endm
  228.  
  229. ;*****************************************************************************
  230. ;* bind macros to WINDOWS menu, only if MicroEMACS for WINDOWS is present *
  231. ;*****************************************************************************
  232. !if &seq $sres "MSWIN"          ; test, if this is running under MS Windows
  233.   ; insert separator
  234.   bind-to-menu  nop     ">&Miscellaneous>-@5"
  235.  
  236.   ; create a new underlying pop-up menu for the FFT macros
  237.   macro-to-menu fft     ">&Miscellaneous>F&FT macros@6>FFT &function search@0"
  238.   macro-to-menu fftmark "FFT function search &mark"
  239.   macro-to-menu fftfind "FFT function search &prompt"
  240.   macro-to-menu fftfile "FFT file&list"
  241.   macro-to-menu fftbase "FFT data&base name"
  242. !endif
  243.  
  244. ;*****************************************************************************
  245. ;**** write final message ****
  246. ;*****************************************************************************
  247. write-message "FXT macro package loaded"
  248.  
  249. ;**** THIS IS THE END THIS IS THE END THIS IS THE END THIS IS THE END ****
  250.  
  251.